load("clean_svybydemog_data.RData")
Gender equity in Louisville is an unfortunately unequal reality. Women are worse off in key standard of living areas such as household income and home-ownership. Additionally, these issues are exasperated for women from a one-income home, women with children and minority women. Disproportionate cost of living burdens and care-taking responsibilities can perpetuate a viscous cycle of inequity. Understanding the true size of the ‘equity gap’ can help inform policy decisions to stop this cycle from continuing.
Key Takeaways:
#fix formatting
single_earner_pctiles <- lville_2019 %>%
group_by(sex) %>%
summarize(
ten_pct = Hmisc::wtd.quantile(HHINCOME, HHWT, probs = 0.1),
twenty_five_pct = Hmisc::wtd.quantile(HHINCOME, HHWT, probs = 0.25),
fifty_pct = Hmisc::wtd.quantile(HHINCOME, HHWT, probs = 0.5),
seventy_five_pct = Hmisc::wtd.quantile(HHINCOME, HHWT, probs = 0.75),
ninety_pct = Hmisc::wtd.quantile(HHINCOME, HHWT, probs = 0.9))
library(gt)
gt(single_earner_pctiles) %>%
tab_header(title = "Income Percentiles by Sex",
subtitle = "") %>%
fmt_currency(columns = vars(ten_pct, twenty_five_pct, fifty_pct, seventy_five_pct,
ninety_pct),
use_subunits = F) %>%
cols_label(ten_pct = "10th",
twenty_five_pct = "25th",
fifty_pct = "Median",
seventy_five_pct = "75th",
ninety_pct = "90th") %>%
cols_align(align = "center") %>%
tab_source_note(
source_note = md("Source: ACS microdata from IPUMS-USA")) %>%
opt_row_striping(row_striping = TRUE) %>%
opt_table_outline() %>%
tab_options(
table.font.size = px(12),
table.width = pct(50)) %>%
tab_style(
cell_text(
font = "Montserrat",
weight = "bold"),
cells_row_groups())
| Income Percentiles by Sex | |||||
| sex | 10th | 25th | Median | 75th | 90th |
|---|---|---|---|---|---|
| female | $11,200 | $25,000 | $50,000 | $91,000 | $152,000 |
| male | $18,000 | $37,000 | $66,900 | $108,400 | $170,000 |
| Source: ACS microdata from IPUMS-USA | |||||
p <- lville_2019 %>%
filter(HHINCOME <= cut_95,
earner_type == "single_earner") %>%
func_plt_hist_overlay( "sex")
p <- p + glp_graph_theme
p <- p + labs(
title = "Single Earner Income by Gender",
) +
ylab(" ") +
guides(color = FALSE) +
facet_wrap(~sex, nrow = 2) +
theme(
#axis.ticks.x = element_line(size = 50000),
strip.text = element_blank()
) +
scale_x_continuous(
breaks = c(50000, 100000, 150000, 200000),
label = c("$50k", "$100k", "$150k", "$200k")
) +
scale_y_continuous(labels = scales::comma)
p
temp_df <- lville_2019 %>%
filter(HHINCOME <= cut_95,
earner_type == "single_earner")
p_percent <- ggplot(temp_df, aes(x=HHINCOME,
y = (..count..)/sum(..count..),
fill=sex,
color = sex,
weight = HHWT)) +
geom_histogram(alpha=0.5, position = 'identity', binwidth = 10000) +
scale_fill_manual(values = c("#0E4A99", "#F58021", "#00A9B7")) +
scale_color_manual(values = c("#0E4A99", "#F58021", "#00A9B7")) +
labs(fill="") +
xlab("Household Income") +
ylab("Percentage")
p_percent <- p_percent + glp_graph_theme
p_percent <- p_percent + labs(
title = "Single Earner Income by Gender",
) +
ylab(" ") +
guides(color = FALSE) +
facet_wrap(~sex, nrow = 2) +
theme(
#axis.ticks.x = element_line(size = 50000),
strip.text = element_blank()
) +
scale_x_continuous(
breaks = c(50000, 100000, 150000, 200000),
label = c("$50k", "$100k", "$150k", "$200k")
) +
scale_y_continuous(labels=percent)
p_percent
##add original faceted graph
sing_fem_inc_race<-census_microdata081122 %>%
filter(
FIPS == "21111",
year %in% 2016:2019,
sex == 'female',
earner_type == 'single_earner',
HHINCOME <= cut_95)
sing_fem_inc_race_plt <- sing_fem_inc_race %>%
ggplot( aes(x=HHINCOME,
y = (..count..)/sum(..count..),
fill=race,
color = race,
weight = HHWT)) +
geom_histogram(alpha=0.5, position = 'identity', binwidth = 10000)
sing_fem_inc_race_plt <- sing_fem_inc_race_plt + facet_wrap(~race, nrow = 2)
sing_fem_inc_race_plt <- sing_fem_inc_race_plt + glp_graph_theme
sing_fem_inc_race_plt <- sing_fem_inc_race_plt +
labs(
title = "Female Single Earner Income",
) +
ylab(" ") +
xlab("Household Income")
# guides(color = FALSE)
sing_fem_inc_race_plt <- sing_fem_inc_race_plt +
theme(
#axis.ticks.x = element_line(size = 50000),
strip.text = element_blank()
) +
scale_x_continuous(
breaks = c(50000, 100000, 150000),
label = c("$50k", "$100k", "$150k")
) +
scale_y_continuous(labels = scales::percent)
sing_fem_inc_race_plt <- sing_fem_inc_race_plt +
scale_fill_manual(values = c("#0E4A99", "#F58021","#00A9B7", "#800055")) +
scale_color_manual(values = c("#0E4A99","#F58021","#00A9B7", "#800055"))
sing_fem_inc_race_plt
black_female_earner <- func_income_by_race("black")
black_female_earner
### Single Hispanic Female Earners
hisp_female_earner <- func_income_by_race("hispanic")
hisp_female_earner <- hisp_female_earner +
labs(
title = "Hispanic Female Single Earner Income",
) +
scale_fill_manual(values = "#0E4A99") +
scale_color_manual(values = "#0E4A99")
hisp_female_earner
white_female_earner <- func_income_by_race("white")
white_female_earner <- white_female_earner +
labs(
title = "White Female Single Earner Income",
) +
scale_fill_manual(values = "#F58021") +
scale_color_manual(values = "#F58021")
white_female_earner
other_female_earner <- func_income_by_race("other")
other_female_earner <- other_female_earner +
labs(
title = "Other Female Single Earner Income",
) +
scale_fill_manual(values = "#00A9B7") +
scale_color_manual(values = "#00A9B7")
other_female_earner
func_income_by_kids <- function(num_kids, living_wage) {
w <- census_microdata081122 %>%
filter(
FIPS == "21111",
year %in% 2016:2019,
sex == 'female',
NCHILD == num_kids,
earner_type == 'single_earner',
HHINCOME <= cut_95)
w <- w %>%
ggplot( aes(x=HHINCOME,
y = (..count..)/sum(..count..),
fill = sex,
group = sex,
weight = HHWT)) +
geom_histogram(alpha=0.5, position = 'identity', binwidth = 10000) +
geom_vline( aes(xintercept = living_wage), linetype = "dashed", colour="blue", size = 1.5)
#sing_fem_inc_race_plt <- sing_fem_inc_race_plt + facet_wrap(~race, nrow = 2)
w <- w + glp_graph_theme
w <- w +
labs(
title = "Black Female Single Earner Income",
) +
ylab(" ") +
xlab("Household Income")+
guides(color = FALSE)
w <- w +
theme(
#axis.ticks.x = element_line(size = 50000),
strip.text = element_blank()
) +
scale_x_continuous(
breaks = c(50000, 100000, 150000),
label = c("$50k", "$100k", "$150k")
) +
scale_y_continuous(labels = scales::percent)
return (w)
}
#why is color not working?
#still need to add living wage lines
under_liv_wage_0 <- census_microdata081122 %>%
filter(
FIPS == "21111",
year %in% 2016:2019,
sex == 'female',
NCHILD == 0,
earner_type == 'single_earner') %>%
group_by(HHINCOME < 30303.98) %>%
summarize(count = sum(HHWT)) #a little more than half are earning a living wage
#do this for each graphof this type...add info above chunk
no_kids_female_earner <- func_income_by_kids(0, 30303.98)
no_kids_female_earner <- no_kids_female_earner +
labs(
title = "Female Single Earner Income, No Children",
) +
scale_fill_discrete(labels = "No Children")
no_kids_female_earner
under_liv_wage_1 <- census_microdata081122 %>%
filter(
FIPS == "21111",
year %in% 2016:2019,
sex == 'female',
NCHILD == 1,
earner_type == 'single_earner') %>%
group_by(HHINCOME < 60264.75) %>%
summarize(count = sum(HHWT))
one_child <- func_income_by_kids(1, 60264.75)
one_child <- one_child +
labs(
title = "Female Single Earner Income, One Child",
) +
scale_fill_manual(values = "#800055", labels = "One Child" ) +
scale_color_manual(values = "#800055")
one_child
under_liv_wage_2 <- census_microdata081122 %>%
filter(
FIPS == "21111",
year %in% 2016:2019,
sex == 'female',
NCHILD == 2,
earner_type == 'single_earner') %>%
group_by(HHINCOME < 76451.81) %>%
summarize(count = sum(HHWT))
two_child <- func_income_by_kids(2, 76451.81)
two_child <- two_child +
labs(
title = "Female Single Earner Income, Two Children",
) +
scale_fill_manual(values = "#356E39", labels = "Two Children") +
scale_color_manual(values = "#356E39")
two_child
under_liv_wage_3 <- census_microdata081122 %>%
filter(
FIPS == "21111",
year %in% 2016:2019,
sex == 'female',
NCHILD == 3,
earner_type == 'single_earner') %>%
group_by(HHINCOME < 101452.61) %>%
summarize(count = sum(HHWT))
three_child <- func_income_by_kids(3, 101452.61)
three_child <- three_child +
labs(
title = "Female Single Earner Income With Three Children",
) +
scale_fill_manual(values = "#CFB94C", labels = "Three Children") +
scale_color_manual(values = "#CFB94C")
three_child
these_labels <- paste0(dollar(seq(1, 273500, 10000), scale = 0.001, accuracy = 1, suffix = "k"))
cost_burden_sf <- lville_2019 %>%
filter(
sex == 'female',
earner_type == 'single_earner',
HHINCOME <= cut_95) %>%
mutate(
cost_burden = factor(cost_burden,
levels = rev(c(TRUE, FALSE)),
labels = rev(c("Cost Burdened", "Non Cost Burdened")),
ordered = TRUE),
inc_bins = cut(HHINCOME, seq(1, 283500, 10000),
labels = these_labels) %>%
factor(levels = these_labels, ordered = TRUE)
)
temp_df <- cost_burden_sf %>%
group_by(inc_bins, cost_burden) %>%
summarize(count = sum(HHWT), .groups = "drop") %>%
complete(inc_bins, cost_burden, fill = list(count = 0)) %>%
filter(!is.na(inc_bins)) %>%
group_by(inc_bins) %>%
mutate(percent = count / sum(count)) %>%
ungroup() %>%
filter(cost_burden == "Cost Burdened")
temp_df <- temp_df[1:14,]
cost_burden_sf_plot <- ggplot(temp_df,
aes(x = inc_bins,
y = percent,
group = 1)) +
geom_line(linetype = "dotted", color="purple", size=3) +
geom_point(color="purple", size=8)
cost_burden_sf_plot <- cost_burden_sf_plot + glp_graph_theme
cost_burden_sf_plot <- cost_burden_sf_plot +
labs(
title = "Female Single Earner Cost Burden Level by Income",
) +
ylab(" ") +
xlab("Household Income") +
guides(color = FALSE) +
theme(
strip.text = element_blank()
) +
scale_color_manual(values = c("#0E4A99")) +
scale_y_continuous(labels = scales::percent)
cost_burden_sf_plot
#I_CB_earn_trend <- survey_by_demog(census_microdata081122, weight_var = "HHWT", 'cost_burden', other_grouping_vars = c('earner_type'), breakdowns = "sex")
# I_CB_earn_trend <- survey_by_demog(census_microdata081122, weight_var = "HHWT", 'cost_burden', other_grouping_vars = c('earner_type_d'))
I_CB_earn_trend %<>%
filter(
var_type == 'percent',
race == 'total',
sex == 'total') %>%
select( -c(sex,race)) %>%
pivot_wider(names_from = "earner_type_d", values_from = "cost_burden")
trend(I_CB_earn_trend,
multiple_earner:single_fem_earner:single_male_earner,
pctiles = F,
plot_title = "Cost Burden by Earner Type",
cat = c("Multiple Earners" = "multiple_earner", "Single Female Earner" = "single_fem_earner", "Single Male Earner" = "single_male_earner"),
y_title = 'Percent',
caption_text =
"Source Greater Louisville Project
Data from GLP analysis of ACS microdata from IPUMS-USA")
I_median_earn_age <- lville_2019 %>%
group_by(age_group, earner_type_d) %>%
summarize(Med=median(HHINCOME))
I_median_earn_age_plot <- ggplot(I_median_earn_age,
aes(x=age_group, y=Med, fill = earner_type_d)) +
geom_bar(stat="identity", position='dodge')
I_median_earn_age_plot <- I_median_earn_age_plot + glp_graph_theme
I_median_earn_age_plot <- I_median_earn_age_plot +
labs(
title = "Median Earnings by Age Group",
) +
ylab("Household Income") +
xlab("Age Group") +
scale_y_continuous(labels = scales::dollar) +
scale_fill_manual(
values = c("#0E4A99", "#F58021", "#00A9B7"),
labels = c("Multiple Earner", "Single Female Earner", "Single Male Earner"))
I_median_earn_age_plot
temp_df <- H_earntype %>%
filter(race == 'total',
var_type == "percent", sex == "total") %>%
pivot_wider(names_from = "earner_type_d", values_from = "homeownership")
trend(temp_df,
multiple_earner:single_male_earner,
plot_title = "Homeownership by Year",
cat = c("Multiple Earners" = "multiple_earner", "Single Female" = "single_fem_earner", "Single Male" = "single_male_earner"),
pctiles = F,
y_title = 'Percent',
rollmean = 3,
caption_text =
"Source: Greater Louisville Project
Data from GLP analysis of ACS microdata from IPUMS-USA")
temp_df <- H_earntype %>%
filter(earner_type_d == "single_fem_earner",
var_type == "percent", sex == "total") %>%
mutate(sex = "total")
ranking(temp_df,
'homeownership',
plot_title = "Single Earner Female Homeownership",
caption_text =
"Source: Greater Louisville Project
Data from GLP analysis of ACS microdata from IPUMS-USA")
H_s_Femkids_trend %<>%
filter(
var_type == 'percent',
race == 'total',
sex == "female") %>%
pivot_wider(names_from = 'kd_pres', values_from = 'homeownership') %>%
select(-sex)
trend(H_s_Femkids_trend,
kids:no_kids,
rollmean = 3,
plot_title = "Female Homeownership by Presence of Children",
cat = c("Children" = "kids", "No Children" = "no_kids"),
y_title = 'Percent',
caption_text =
"Source: Greater Louisville Project
Data from GLP analysis of ACS microdata from IPUMS-USA")
ranking(H_sinFem_kids,
'homeownership',
plot_title = "Single Earner Female Homeownership with Children",
#title_scale = 0.8,
caption_text =
"Source: Greater Louisville Project
Data from GLP analysis of ACS microdata from IPUMS-USA")
temp_df <- H_earntype %>%
filter(earner_type_d == "single_fem_earner",
var_type == "percent", sex == "total")
trend(filter(temp_df, race != "hispanic"),
homeownership,
rollmean = 3,
pctiles = F,
plot_title = "Single Female Homeownership by Year",
cat = 'race',
y_title = 'Percent',
caption_text =
"Source Greater Louisville Project
Data from GLP analysis of ACS microdata from IPUMS-USA")
df_kids_race <- census_microdata081122 %>%
group_by(FIPS, year, race, earner_type_d, kd_pres) %>%
summarize(homeownership = sum(HHWT[homeownership]) / sum(HHWT) * 100, .groups = "drop")
df_kids <- census_microdata081122 %>%
group_by(FIPS, year, earner_type_d, kd_pres) %>%
summarize(homeownership = sum(HHWT[homeownership]) / sum(HHWT) * 100, .groups = "drop") %>%
mutate(race = "total")
df_kids %<>%
bind_rows(df_kids_race) %>%
select(FIPS, year, race, earner_type_d, homeownership, kd_pres) %>%
filter(earner_type_d == "single_fem_earner",
kd_pres == "kids")
trend(filter(df_kids, race != "hispanic"),
homeownership,
rollmean = 3,
pctiles = F,
plot_title = "Single Female Homeownership by Year with Children",
cat = 'race',
y_title = 'Percent',
caption_text =
"Source Greater Louisville Project
Data from GLP analysis of ACS microdata from IPUMS-USA")
df_no_kids_race <- census_microdata081122 %>%
group_by(FIPS, year, race, earner_type_d, kd_pres) %>%
summarize(homeownership = sum(HHWT[homeownership]) / sum(HHWT) * 100, .groups = "drop")
df_no_kids <- census_microdata081122 %>%
group_by(FIPS, year, earner_type_d, kd_pres) %>%
summarize(homeownership = sum(HHWT[homeownership]) / sum(HHWT) * 100, .groups = "drop") %>%
mutate(race = "total")
df_no_kids %<>%
bind_rows(df_no_kids_race) %>%
select(FIPS, year, race, earner_type_d, homeownership, kd_pres) %>%
filter(earner_type_d == "single_fem_earner",
kd_pres == "no_kids")
trend(filter(df_no_kids, race != "hispanic"),
homeownership,
rollmean = 3,
pctiles = F,
plot_title = "Single Female Homeownership by Year without Children",
cat = 'race',
y_title = 'Percent',
caption_text =
"Source Greater Louisville Project
Data from GLP analysis of ACS microdata from IPUMS-USA")
need to add text here
E_singM_singF <- census_microdata081122 %>%
filter(year %in% 2017:2019,
earner_type == 'single_earner') %>%
group_by(sex, educ, kd_pres) %>%
summarize(n=sum(HHWT, na.rm = TRUE)) %>%
mutate(
total = sum(n),
rate = n/sum(n)*100,
educ = factor(educ,
levels = rev(c("no_hs", "hs", "some_col", "assoc", "bach","grad")),
ordered = TRUE))
E_singM_singF_plot <- ggplot(E_singM_singF,
aes(x=sex,
y=rate,
fill = educ)) +
geom_bar(stat="identity", position = "fill")
E_singM_singF_plot <- E_singM_singF_plot + facet_wrap(~kd_pres)
E_singM_singF_plot <- E_singM_singF_plot + glp_graph_theme
E_singM_singF_plot <- E_singM_singF_plot +
theme(
legend.position = "right"
) +
labs(
title = "Single Earner Education Levels by Gender",
) +
ylab(" ") +
xlab(" ") +
scale_fill_discrete(
labels = c("Graduate","Bachelor", "Associate", "Some College", "High School", "No High School")) +
scale_x_discrete (labels = c("female" = "Female", "male" = "Male")) +
scale_y_continuous(labels = scales::percent)
E_singM_singF_plot
E_singF_race <- lville_2019 %>%
filter(
sex == 'female',
earner_type == 'single_earner') %>%
group_by(race, educ) %>%
summarize(n=sum(HHWT, na.rm = TRUE)) %>%
mutate(
total = sum(n),
rate = n/sum(n)*100,
educ = factor(educ,
levels = rev(c("no_hs", "hs", "some_col", "assoc", "bach","grad")),
ordered = TRUE))
E_singF_race_plot <- ggplot(E_singF_race, aes(x=race, y=rate, fill=educ)) +
geom_bar(stat="identity", position='fill')
E_singF_race_plot <- E_singF_race_plot + glp_graph_theme
E_singF_race_plot <- E_singF_race_plot +
theme(
legend.position = "right"
) +
labs(
title = "Single Female Education Breakdown",
) +
ylab(" ") +
xlab("Race") +
scale_fill_discrete(labels = c("Graduate","Bachelor", "Associate", "Some College", "High School", "No High School")) +
scale_x_discrete (labels = c("female" = "Female", "male" = "Male")) +
scale_y_continuous(labels = scales::percent)
E_singF_race_plot
cost_burden_age_sf %<>% drop_na(cost_burden) #this will need to be run once and then left alone if tweaking graphs
cost_burden_age_sf_plot <- ggplot(cost_burden_age_sf,
aes(x=age_group, y=HHWT , fill=cost_burden),
color="#00A9B7") +
geom_bar(stat="identity", position='fill')
cost_burden_age_sf_plot <- cost_burden_age_sf_plot + glp_graph_theme
cost_burden_age_sf_plot <- cost_burden_age_sf_plot +
theme(
legend.position = "right"
) +
labs(
title = "Cost Burdened Status by Age",
) +
ylab(" ") +
xlab("Race") +
scale_fill_discrete(labels = c("Non Cost Burdened", "Cost Burdened")) +
#scale_x_discrete (labels = c("female" = "Female", "male" = "Male")) +
scale_y_continuous(labels = scales::percent)
cost_burden_age_sf_plot
temp_df1 <- cost_burden_age_sf %>%
filter(earner_type_d == "single_fem_earner") %>%
mutate(
age_group = case_when(
age %in% 15:19 ~ NA_character_,
age %in% 20:29 ~ "20-29",
age %in% 30:39 ~ "30-39",
age %in% 40:49 ~ "40-49",
age %in% 50:59 ~ "50-59",
age %in% 60:69 ~ "60-69",
age %in% 70:79 ~ "70-79",
age >= 80 ~ "80+"))
temp_df1 %<>% filter(!is.na(age_group))
cost_burden_age_sf_facet_plt <- ggplot(temp_df1,
aes(x=age_group, y=HHWT , fill=cost_burden),
color="#00A9B7") +
geom_bar(stat="identity", position='fill')
#facet_wrap(~earner_type_d)
cost_burden_age_sf_facet_plt <- cost_burden_age_sf_facet_plt + glp_graph_theme
cost_burden_age_sf_facet_plt <- cost_burden_age_sf_facet_plt +
theme(
legend.position = "right",
strip.text = element_text(size = 40)
) +
labs(
title = "Cost Burdened Status by Age and Earner Type",
) +
ylab(" ") +
xlab(" ") +
scale_fill_discrete(labels = c("Non Cost Burdened", "Cost Burdened")) +
scale_x_discrete(guide = guide_axis(n.dodge=2)) +
scale_y_continuous(labels = scales::percent)
cost_burden_age_sf_facet_plt
### Male Single Earner
temp_df2 <- cost_burden_age_sf %>%
filter(earner_type_d == "single_male_earner") %>%
mutate(
age_group = case_when(
age %in% 15:19 ~ NA_character_,
age %in% 20:29 ~ "20-29",
age %in% 30:39 ~ "30-39",
age %in% 40:49 ~ "40-49",
age %in% 50:59 ~ "50-59",
age %in% 60:69 ~ "60-69",
age %in% 70:79 ~ "70-79",
age >= 80 ~ "80+"))
temp_df2 %<>% filter(!is.na(age_group))
cost_burden_age_sf_facet_plt <- ggplot(temp_df2,
aes(x=age_group, y=HHWT , fill=cost_burden),
color="#00A9B7") +
geom_bar(stat="identity", position='fill')
#facet_wrap(~earner_type_d)
cost_burden_age_sf_facet_plt <- cost_burden_age_sf_facet_plt + glp_graph_theme
cost_burden_age_sf_facet_plt <- cost_burden_age_sf_facet_plt +
theme(
legend.position = "right",
strip.text = element_text(size = 40)
) +
labs(
title = "Cost Burdened Status by Age and Earner Type",
) +
ylab(" ") +
xlab(" ") +
scale_fill_discrete(labels = c("Non Cost Burdened", "Cost Burdened")) +
scale_x_discrete(guide = guide_axis(n.dodge=2)) +
scale_y_continuous(labels = scales::percent)
cost_burden_age_sf_facet_plt
temp_df3 <- cost_burden_age_sf %>%
filter(earner_type_d == "multiple_earner") %>%
mutate(
age_group = case_when(
age %in% 15:19 ~ NA_character_,
age %in% 20:29 ~ "20-29",
age %in% 30:39 ~ "30-39",
age %in% 40:49 ~ "40-49",
age %in% 50:59 ~ "50-59",
age %in% 60:69 ~ "60-69",
age %in% 70:79 ~ "70-79",
age >= 80 ~ "80"))
temp_df3 %<>% filter(!is.na(age_group))
cost_burden_age_sf_facet_plt <- ggplot(temp_df3,
aes(x=age_group, y=HHWT , fill=cost_burden),
color="#00A9B7") +
geom_bar(stat="identity", position='fill')
#facet_wrap(~earner_type_d)
cost_burden_age_sf_facet_plt <- cost_burden_age_sf_facet_plt + glp_graph_theme
cost_burden_age_sf_facet_plt <- cost_burden_age_sf_facet_plt +
theme(
legend.position = "right",
strip.text = element_text(size = 40)
) +
labs(
title = "Cost Burdened Status by Age and Earner Type",
) +
ylab(" ") +
xlab(" ") +
scale_fill_discrete(labels = c("Non Cost Burdened", "Cost Burdened")) +
scale_x_discrete(guide = guide_axis(n.dodge=2)) +
scale_y_continuous(labels = scales::percent)
cost_burden_age_sf_facet_plt
earner_trend <- census_microdata081122 %>%
mutate(
earner_type_d = case_when(
sex == 'female' & earner_type == 'single_earner' ~ 'single_fem_earner',
sex == 'male' & earner_type == 'single_earner' ~ 'single_male_earner',
earner_type == 'multi_earner' ~ 'multiple_earner')
) %>%
group_by(year, earner_type_d) %>%
summarize(n=sum(HHWT, na.rm = TRUE)) %>%
mutate(
total = sum(n),
rate = n/sum(n)*100)
earner_trend_plt <- ggplot(earner_trend,
aes(x=year, y=rate, fill=earner_type_d),
color="#00A9B7") +
geom_bar(stat="identity", position='fill')
earner_trend_plt <- earner_trend_plt + glp_graph_theme
earner_trend_plt <- earner_trend_plt +
theme(
legend.position = "right"
#strip.text = element_blank()
) +
labs(
title = "Earner Type Trend"
) +
ylab(" ") +
xlab(" ") +
scale_fill_discrete(labels = c("Multiple Earner", "Single Female Earner", "Single Male Earner")) +
scale_y_continuous(labels = scales::percent)
earner_trend_plt